﻿
Partial Class _TopicManage
    Inherits System.Web.UI.Page
    Public Shared Function MD5(ByVal strSource As String, ByVal Code As Int16) As String
        '这里用的是ascii编码密码原文，如果要用汉字做密码，可以用UnicodeEncoding，但会与ASP中的MD5函数不兼容 
        Dim dataToHash As Byte() = (New System.Text.ASCIIEncoding).GetBytes(strSource)
        Dim hashvalue As Byte() = CType(System.Security.Cryptography.CryptoConfig.CreateFromName("MD5"), System.Security.Cryptography.HashAlgorithm).ComputeHash(dataToHash)
        Dim i As Integer
        Select Case Code
            Case 16 '´选择16位字符的加密结果 
                For i = 4 To 11
                    MD5 += Hex(hashvalue(i)).ToLower
                Next
            Case 32 ' ´选择32位字符的加密结果 
                For i = 0 To 15
                    MD5 += Hex(hashvalue(i)).ToLower
                Next
            Case Else ' ´Code错误时，返回全部字符串，即32位字符 
                For i = 0 To hashvalue.Length - 1
                    MD5 += Hex(hashvalue(i)).ToLower
                Next
        End Select
    End Function
    Function EncodeBase64(ByVal StrA)
        Dim BufferA As Byte()
        BufferA = System.Text.Encoding.Default.GetBytes(StrA)
        Dim StrB As String
        StrB = Convert.ToBase64String(BufferA)
        EncodeBase64 = StrB
    End Function
    Function DecodeBase64(ByVal StrA)
        DecodeBase64 = Encoding.GetEncoding("gb2312").GetString(Convert.FromBase64String(StrA))
    End Function
    Function ISexist(ByVal topicType, ByVal eventid)
        Dim connstr, conn, rs, path, sql
        connstr = ConfigurationSettings.AppSettings("SQLConnString") & """" & Server.MapPath(".") & "\..\" & ConfigurationSettings.AppSettings("dbPath") & """"
        conn = Server.CreateObject("ADODB.Connection")
        conn.open(connstr)
        If topicType = "1" Then
            path = "../zhuti/"
            sql = "select *  from [Poster] where [PosterID]=" & eventid
        Else
            path = "../poster/"
            sql = "select *  from [Topic] where [TopicID]=" & eventid
        End If
        rs = Server.CreateObject("adodb.recordset")
        rs.open(sql, conn, 1, 3)
        If Not rs.eof Then
            If CheckFile(path & rs("FilePath").value) Then
                ISexist = "Yes"
            Else
                ISexist = "NO"
            End If
        Else
            ISexist = "NO"

        End If
        rs.close()
        conn.close()
    End Function

    Function CheckFile(ByVal ckDirname)
        On Error Resume Next
        Dim M_fso
        CheckFile = False
        M_fso = CreateObject("Scripting.FileSystemObject")
        If (M_fso.FileExists(Server.MapPath(ckDirname))) Then
            CheckFile = True
        End If
        M_fso = Nothing
    End Function


    Function getstr(ByVal iRemote)
        On Error Resume Next
        Dim xPost, sGet
        xPost = Server.CreateObject("msxml2.serverxmlhttp") 'msxml2.serverxmlhttp
        xPost.Open("GET", iRemote, False)
        xPost.Send()
        sGet = CreateObject("ADODB.Stream")
        sGet.Mode = 3
        sGet.Type = 1
        sGet.Open()
        sGet.Write(xPost.responseBody)
        sGet.Position = 0
        sGet.Type = 2
        sGet.Charset = "gb2312" ' "gb2312"
        If Err.Number <> 0 Then
            Response.Write(Err.Description & "<font color=""#FF0000"">(ErrorCode:" & Err.Number & ")</font>")
            Response.End()
        End If
        getstr = sGet.ReadText
    End Function


    Public Function getTstr(ByVal txt, ByVal str1, ByVal strA1, ByVal strA2, ByVal str2, ByVal ISinstr, ByVal StrSelf, ByVal islink, ByVal ignorecase, ByVal SplitStr, ByVal Scount)
        On Error Resume Next
        Dim MatchStyle, sl, isin, getTstrA, i, txtA, syx
        MatchStyle = ""
        getTstr = ""
        txtA = LCase(txt)
        If ignorecase = "1" Then '是否忽略大小写
            If InStr(txtA, LCase(str1)) = 0 Or InStr(txtA, LCase(str2)) = 0 Then Exit Function '没有发现目标字符串。退出
        Else
            If InStr(txt, str1) = 0 Or InStr(txt, str2) = 0 Then Exit Function '没有发现目标字符串。退出
        End If

        ISinstr = LCase(ISinstr)
        If ISinstr <> "" Then
            If InStr(Left(ISinstr, 4), "|") Then
                MatchStyle = Trim(Left(ISinstr, InStr(ISinstr, "|") - 1))
                ISinstr = Right(ISinstr, Len(ISinstr) - InStr(ISinstr, "|"))
            End If
            If MatchStyle <> "and" And MatchStyle <> "or" Then
                MatchStyle = "or"
            End If
            ISinstr = Split(ISinstr, "(-+)")
            isin = "false"
        Else
            isin = "true"
        End If
        sl = 1
        Do While sl > 0
            If ignorecase = "1" Then '是否忽略大小写
                sl = InStr(sl, txtA, LCase(str1))
            Else
                sl = InStr(sl, txt, str1)
            End If

            If sl = 0 Then Exit Do
            If StrSelf = "0" Then '是否返回条件字符
                getTstrA = Right(txt, Len(txt) - sl - Len(str1) + 1)
                getTstrA = Left(getTstrA, InStr(1, getTstrA, str2) - 1)
                If InStr(getTstrA, str1) Then getTstrA = Right(getTstrA, Len(getTstrA) - InStrRev(getTstrA, str1) - Len(str1) + 1)
            Else
                getTstrA = Right(txt, Len(txt) - sl + 1)
                If ignorecase = "1" Then '是否忽略大小写
                    getTstrA = Left(getTstrA, InStr(1, LCase(getTstrA), LCase(str2)) + Len(str2) - 1)
                Else
                    getTstrA = Left(getTstrA, InStr(1, getTstrA, str2) + Len(str2) - 1)
                End If
                If InStr(Len(str1), getTstrA, str1) Then getTstrA = Right(getTstrA, Len(getTstrA) - InStrRev(getTstrA, str1) + 1)
            End If
            If ISinstr <> "" Then
                If MatchStyle = "and" Then isin = "true"
                For i = 0 To UBound(ISinstr)

                    If MatchStyle = "or" Then '多条件（不要求同时满足 OR)
                        If InStr(getTstrA, ISinstr(i)) Then
                            isin = "true"
                            Exit For
                        End If
                    End If

                    If MatchStyle = "and" Then '多条件（要求同时满足 AND)
                        If InStr(getTstrA, ISinstr(i)) = 0 Then
                            'isin="true"
                            'else
                            isin = "false"
                            Exit For
                        End If
                    End If

                Next
            End If
            If strA1 <> "" Then
                syx = InStr(getTstrA, strA1)
                If syx = 0 Then Exit Function
                If StrSelf = "0" Then '是否返回条件字符
                    getTstrA = Right(getTstrA, Len(getTstrA) - InStr(getTstrA, strA1) - Len(strA1) + 1)
                Else
                    getTstrA = Right(getTstrA, Len(getTstrA) - InStr(getTstrA, strA1) + 1)
                End If

            End If
            If strA2 <> "" Then
                syx = InStr(1, getTstrA, strA2)
                If syx = 0 Then Exit Function
                If StrSelf = "0" Then '是否返回条件字符
                    getTstrA = Left(getTstrA, InStr(1, getTstrA, strA2) - 1)
                Else
                    ' getTstrA = Left(getTstrA, InStr(Len(strA1) + 1, getTstrA, strA2) + Len(strA2) - 1)
                End If

            End If

            getTstrA = Replace(getTstrA, vbTab, "")
            getTstrA = Replace(getTstrA, vbNewLine, "")
            getTstrA = Trim(getTstrA)


            If getTstrA <> "" Then
                If isin = "true" Then

                    If getTstrA <> "" Then
                        getTstr = getTstr & getTstrA & SplitStr ' & "-------------------------------------------------------------------------------" & vbNewLine
                    End If
                End If
                If Scount = 0 Then Exit Do
            End If
            sl = sl + 1 'len(getTstr)
        Loop
    End Function

    Function CreatePosterFile(ByVal topicType, ByVal category, ByVal pid, ByVal toPage, ByVal eventid, ByVal PosterCount)
        On Error Resume Next
        Dim url, Htmlcode, PosterName, PosterID, PublishDate, curPage, totalPage, objFso, path, filename, ts, sql
        Dim PIC, PIC360x190, PIC250x60, linkWord, title, Atitle
        If pid = "" Then pid = "10011550"
        Dim connstr, conn, rs
        connstr = ConfigurationSettings.AppSettings("SQLConnString") & """" & Server.MapPath(".") & "\..\" & ConfigurationSettings.AppSettings("dbPath") & """"
        conn = Server.CreateObject("ADODB.Connection")
        conn.open(connstr)
        Dim Site_Name, Site_Title, Site_Logo, Site_Keywords, Site_Description, Site_Copyright, Site_Url
        rs = Server.CreateObject("adodb.recordset")
        rs.open("select *  from Config", conn, 1, 3)
        Site_Name = rs("Site_Name").value
        Site_Title = rs("Site_Title").value
        Site_Logo = rs("Site_Logo").value
        If InStr(LCase(Site_Logo), "http://") = 0 Then
            Site_Logo = "../" & Site_Logo
        End If
        Site_Keywords = rs("Site_Keywords").value
        Site_Description = rs("Site_Description").value
        pid = rs("Pid").value
        Site_Copyright = rs("Site_Copyright").value
        rs.close()
        rs.open("select *  from Template", conn, 1, 3)
        Dim Header, Footer
        Site_Url = "http://" & Request.ServerVariables("server_name")
        If Not rs.eof Then
            Header = rs("header").value
            Footer = rs("Footer").value
            Header = Replace(Header, "{$Site_Url$}", Site_Url)
            Header = Replace(Header, "{$site_Logo$}", Site_Logo)
            Header = Replace(Header, "{$Pid$}", pid)
            Header = Replace(Header, "{$Site_Name$}", Site_Name)
            Header = Replace(Header, "{$Site_Description$}", Site_Description)
            Header = Replace(Header, "{$Site_Keywords$}", Site_Keywords)
            Footer = Replace(Footer, "{$Site_Url$}", Site_Url)
            Footer = Replace(Footer, "{$Site_Name$}", Site_Name)
        End If
        rs.close()
        If LCase(PosterCount) = "all" Then
            url = "http://taoke.alimama.com/taobao_topics.htm?topicType=" & topicType & "&category=" & category & "&toPage=" & toPage

            Htmlcode = getstr(url)
            PosterName = Split(getTstr(Htmlcode, "cover_opacity", "<strong>", "</strong>", "</li>", "", "0", "0", "0", "@.@", "1"), "@.@")
            PosterID = Split(getTstr(Htmlcode, "cover_opacity", "eventid=", """>", "</li>", "", "0", "0", "0", "@.@", "1"), "@.@")
            PublishDate = Split(getTstr(Htmlcode, "cover_opacity", "发布时间：", "</span>", "</li>", "", "0", "0", "0", "@.@", "1"), "@.@")
            curPage = Trim(getTstr(Htmlcode, """curPage"":", "", "", ",", "", "0", "0", "0", "", "0"))
            totalPage = Trim(getTstr(Htmlcode, """totalPage"":", "", "", ",", "", "0", "0", "0", "", "0"))
            If totalPage = "" Then totalPage = "1"

            objFso = Server.CreateObject("Scripting.FileSystemObject")
            If topicType = "1" Then
                path = "../zhuti/"
            End If

            If topicType = "2" Then
                path = "../poster/"
            End If
            If (objFso.FolderExists(Server.MapPath(path))) Then '判断文件夹是否存在
            Else
                objFso.CreateFolder(Server.MapPath(path))
            End If

            Dim i
            For i = 0 To UBound(PosterName)
                If PosterID(i) <> "" Then

                    If topicType = "1" Then
                        url = "http://zhuti.huoban.taobao.com/event.php?pid=mm_" & pid & "_0_0&eventid=" & PosterID(i)
                        sql = "select *  from [Poster] where [PosterID]=" & PosterID(i)
                    End If

                    If topicType = "2" Then
                        url = "http://haibao.huoban.taobao.com/tms/topic.php?pid=mm_" & pid & "_0_0&eventid=" & PosterID(i)
                        sql = "select *  from [Topic] where [TopicID]=" & PosterID(i)
                    End If
                    Htmlcode = getstr(url)
                    Atitle = Trim(getTstr(LCase(Htmlcode), "<title>", "", "", "</title>", "", "0", "0", "0", "", "0"))
                    Htmlcode = Replace(Header, "{$title$}", Atitle & " - " & Site_Title) & Htmlcode & Footer
                    filename = path & PosterID(i) & ".html"
                    ts = objFso.createtextfile(Server.MapPath(filename), True)
                    ts.write(Htmlcode) '写s文件
                    ts.close()
                    title = getTstr(Htmlcode, "<title>", "", "", "</title>", "", "0", "0", "0", "", "0") & "@.@"
                    '写数据库
                    Htmlcode = getstr("http://taoke.alimama.com/spreader/topic/genTopicCode.htm?eventid=" & PosterID(i))
                    PIC250x60 = getTstr(Htmlcode, "getPhotoCode('bannerDescs3')", "src=""", """", "leftarrow", "", "0", "0", "0", "", "1")
                    PIC360x190 = getTstr(Htmlcode, "getPhotoCode('bannerDescs9')", "src=""", """", "leftarrow", "", "0", "0", "0", "", "1")
                    PIC = PIC360x190 & "@.@" & PIC250x60
                    'Response.Write(PIC)
                    linkWord = getTstr(Htmlcode, "')"" value=""", "", "", """>", "", "0", "0", "0", "@.@", "1")
                    If InStr(linkWord, title) Then linkWord = linkWord & title
                    'Response.End()

                    rs = Server.CreateObject("adodb.recordset")
                    rs.open(sql, conn, 1, 3)
                    If rs.eof Then
                        rs.addnew()
                        rs("PosterName").value = PosterName(i)
                        rs("PosterID").value = PosterID(i)
                        rs("PublishDate").value = PublishDate(i)
                        rs("FilePath").value = PosterID(i) & ".html"
                        rs("category").value = category
                        rs("linkWord").value = linkWord
                        rs("PIC").value = PIC
                        rs.update()
                    Else
                        rs("PosterName").value = PosterName(i)
                        rs("PosterID").value = PosterID(i)
                        rs("PublishDate").value = PublishDate(i)
                        rs("FilePath").value = PosterID(i) & ".html"
                        rs("category").value = category
                        rs("linkWord").value = linkWord
                        rs("PIC").value = PIC
                        rs.update()
                    End If
                    rs.close()
                End If

            Next






            If curPage = "" Then
                CreatePosterFile = "0"
                Exit Function
            End If

            If (Int(curPage) + 1) > Int(totalPage) Then
                curPage = "0"
            Else
                curPage = Int(curPage) + 1
            End If
            CreatePosterFile = curPage '输出下一页
            rs.close()
            conn.close()

        Else '单个采集分支


            If eventid <> "" Then

                If topicType = "1" Then
                    url = "http://zhuti.huoban.taobao.com/event.php?pid=mm_" & pid & "_0_0&eventid=" & eventid
                    path = "../zhuti/"
                    sql = "select *  from [Poster] where [PosterID]=" & eventid
                End If

                If topicType = "2" Then
                    url = "http://haibao.huoban.taobao.com/tms/topic.php?pid=mm_" & pid & "_0_0&eventid=" & eventid
                    path = "../poster/"
                    sql = "select *  from [Topic] where [TopicID]=" & eventid
                End If


                objFso = Server.CreateObject("Scripting.FileSystemObject")  '判断文件夹是否存在
                If (objFso.FolderExists(Server.MapPath(path))) Then
                Else
                    objFso.CreateFolder(Server.MapPath(path))
                End If

                Htmlcode = getstr(url)
                Atitle = Trim(getTstr(LCase(Htmlcode), "<title>", "", "", "</title>", "", "0", "0", "0", "", "0"))
                Htmlcode = Replace(Header, "{$title$}", Atitle & " - " & Site_Title) & Htmlcode & Footer
                filename = path & eventid & ".html"
                ts = objFso.createtextfile(Server.MapPath(filename), True)
                ts.write(Htmlcode)
                ts.close()
                title = getTstr(Htmlcode, "<title>", "", "", "</title>", "", "0", "0", "0", "", "0") & "@.@"
                Htmlcode = getstr("http://taoke.alimama.com/spreader/topic/genTopicCode.htm?eventid=" & eventid)
                PIC250x60 = getTstr(Htmlcode, "getPhotoCode('bannerDescs3')", "src=""", """", "leftarrow", "", "0", "0", "0", "", "1")
                PIC360x190 = getTstr(Htmlcode, "getPhotoCode('bannerDescs11')", "src=""", """", "leftarrow", "", "0", "0", "0", "", "1")
                PIC = PIC360x190 & "@.@" & PIC250x60
                'Response.Write(PIC)
                linkWord = getTstr(Htmlcode, "')"" value=""", "", "", """>", "", "0", "0", "0", "@.@", "1")
                If InStr(linkWord, title) Then linkWord = linkWord & title
                'Response.End()
                '写数据库
                Dim info
                info = Split(Request("info"), ",")
                rs = Server.CreateObject("adodb.recordset")
                rs.open(sql, conn, 1, 3)
                'Response.Write("select *  from [Poster] where [PosterID]=" & eventid)
                'Response.End()
                If rs.eof Then
                    rs.addnew()
                    rs("PosterName").value = info(0)
                    rs("PosterID").value = info(1)
                    rs("PublishDate").value = info(2)
                    rs("FilePath").value = eventid & ".html"
                    rs("category").value = info(3)
                    rs("linkWord").value = linkWord
                    rs("PIC").value = PIC
                    rs.update()
                Else
                    rs("PosterName").value = info(0)
                    rs("PosterID").value = info(1)
                    rs("PublishDate").value = info(2)
                    rs("FilePath").value = eventid & ".html"
                    rs("category").value = info(3)
                    rs("linkWord").value = linkWord
                    rs("PIC").value = PIC
                    rs.update()
                End If
                rs.close()
                conn.close()
                Response.Write(eventid)

            End If
        End If

    End Function
    Function UpName(ByVal id, ByVal name)
        If Trim(name) = "" Then
            UpName = "Error"
            Exit Function
        End If
        Dim connstr, conn, rs
        connstr = ConfigurationSettings.AppSettings("SQLConnString") & """" & Server.MapPath(".") & "\..\" & ConfigurationSettings.AppSettings("dbPath") & """"
        conn = Server.CreateObject("ADODB.Connection")
        conn.open(connstr)
        rs = Server.CreateObject("adodb.recordset")
        rs.open("select *  from [Poster] where [PosterID]=" & id, conn, 1, 3)
        If Not rs.eof Then
            rs("sm") = name
            rs.update()
            UpName = id & "|" & name
        End If
        rs.close()
        conn.close()
    End Function


    Function LoadFile(ByVal File)
        Dim objStream
        On Error Resume Next
        objStream = Server.CreateObject("ADODB.Stream")
        If Err.Number = -2147221005 Then

            Err.Clear()
            Response.End()
        End If
        With objStream
            .Type = 2
            .Mode = 3
            .Open()
            .LoadFromFile(Server.MapPath(File))
            If Err.Number <> 0 Then

                Err.Clear()
                Response.End()
            End If
            .Charset = "GB2312"
            .Position = 2
            LoadFile = .ReadText
            .Close()
        End With
        objStream = Nothing
    End Function


    Public Shared Function MD5x(ByVal strSource As String, ByVal Code As Int16) As String
        '这里用的是ascii编码密码原文，如果要用汉字做密码，可以用UnicodeEncoding，但会与ASP中的MD5函数不兼容 
        Select Case Code
            Case 16 '´选择16位字符的加密结果 
                MD5x = System.Web.Security.FormsAuthentication.HashPasswordForStoringInConfigFile(strSource, "MD5").ToLower().Substring(8, 16)
            Case 32 ' ´选择32位字符的加密结果 
                MD5x = System.Web.Security.FormsAuthentication.HashPasswordForStoringInConfigFile(strSource, "MD5").ToLower()
        End Select
    End Function
    Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        Dim x, b, n, d, j, f, g, r
        If Request.Cookies("TaoddAdmin") Is Nothing Or Request.Cookies("TaoddPassWord") Is Nothing Then
            Response.Redirect("login.aspx")
        Else
            PassPortCheck()
        End If


        If Request("Action") = "Create" Then  '批量生成某一页
            Response.Write(CreatePosterFile(Request("topicType"), Request("category"), "10011550", Request("toPage"), "", "All"))
            Response.End()
            '(ByVal topicType, ByVal category, ByVal pid, ByVal toPage)
        End If

        If Request("Action") = "CreateOne" Then  '生成某一个主题
            Response.Write(CreatePosterFile(Request("topicType"), Request("category"), "10011550", Request("toPage"), Request("eventid"), "One"))
            Response.End()
            '(ByVal topicType, ByVal category, ByVal pid, ByVal toPage)
        End If


        If Request("Action") = "UpName" Then  '更新某一个主题的推广文字
            '  Response.Write(CreatePosterFile(Request("topicType"), Request("category"), "10011550", Request("toPage"), Request("eventid"), "One"))
            Response.Write(UpName(Int(Request("id")), Request("s")))
            Response.End()
            '(ByVal topicType, ByVal category, ByVal pid, ByVal toPage)
        End If
    End Sub
    Function PassPortCheck()
        Dim connstr, connA, rsA
        connstr = ConfigurationSettings.AppSettings("SQLConnString") & """" & Server.MapPath(".") & "\..\" & ConfigurationSettings.AppSettings("dbPath") & """"
        connA = Server.CreateObject("ADODB.Connection")
        connA.open(connstr)
        Dim Admin_UserName, Admin_UserPass
        Admin_UserName = replace(Request.Cookies("TaoddAdmin").value, "'", "''")
        Admin_UserPass = replace(Request.Cookies("TaoddPassWord").value, "'", "''")
        rsA = Server.CreateObject("adodb.recordset")
        rsA.open("select * from [admin^] where Admin_UserName='" & Admin_UserName & "' and Admin_UserPass='" & Admin_UserPass & "'", connA, 1, 3)
        If rsA.eof Then
            Response.Redirect("login.aspx")
        End If
        connA.close()
        connA = Nothing
    End Function
End Class
